home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / allcrack / allgoto.bas < prev    next >
BASIC Source File  |  1999-10-05  |  7KB  |  178 lines
  1. Attribute VB_Name = "allgoto"
  2. Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
  3. Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  4. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  5. Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  6. Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  7. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  8. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
  9. Declare Function ReleaseCapture Lib "user32" () As Long
  10. Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
  11. Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
  12. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  13. Global Const WM_NCLBUTTONDOWN = &HA1
  14. Const conHwndTopmost = -1
  15. Const conHwndNoTopmost = -2
  16. Const conSwpNoActivate = &H10
  17. Const conSwpShowWindow = &H40
  18. Public Const HWND_TOPMOST = -1
  19. Public Const HWND_NOTOPMOST = -2
  20. Public Const NIM_ADD = &H0
  21. Public Const NIM_MODIFY = &H1
  22. Public Const NIM_DELETE = &H2
  23. Public Const NIF_MESSAGE = &H1
  24. Public Const NIF_ICON = &H2
  25. Public Const NIF_TIP = &H4
  26. Public Const WM_MOUSEMOVE = &H200
  27. Public Const WM_LBUTTONDOWN = &H201
  28. Public Const WM_LBUTTONUP = &H202
  29. Public Const WM_LBUTTONDBLCLK = &H203
  30. Public Const WM_RBUTTONDOWN = &H204
  31. Public Const WM_RBUTTONUP = &H205
  32. Public Const WM_RBUTTONDBLCLK = &H206
  33. Public Const SWP_NOMOVE = &H2
  34. Public Const SWP_NOSIZE = &H1
  35. Public Const flags = SWP_NOMOVE Or SWP_NOSIZE
  36. Const KEY_SET_VALUE = &H2&
  37. Const KEY_CREATE_SUB_KEY = &H4&
  38. Const REG_SZ = 1&
  39. Const ERROR_SUCCESS = 0&
  40. Const KEY_NOTIFY = &H10&
  41. Const KEY_ENUMERATE_SUB_KEYS = &H8&
  42. Const KEY_QUERY_VALUE = &H1&
  43. Const READ_CONTROL = &H20000
  44. Const STANDARD_RIGHTS_READ = READ_CONTROL
  45. Const STANDARD_RIGHTS_WRITE = READ_CONTROL
  46. Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
  47. Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
  48. Public nid As NOTIFYICONDATA
  49. Dim MainKeyHandle As Long
  50. Dim rtn As Long
  51. Public Type POINTAPI
  52.         X As Long
  53.         Y As Long
  54. End Type
  55. Public Type NOTIFYICONDATA
  56.         cbSize As Long
  57.         hwnd As Long
  58.         uId As Long
  59.         uFlags As Long
  60.         uCallBackMessage As Long
  61.         hIcon As Long
  62.         szTip As String * 64
  63. End Type
  64. Sub StayOnTop(frm As Form)
  65. Call SetWindowPos(frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  66. End Sub
  67. Sub NotOnTop(frm As Form)
  68. Call SetWindowPos(frm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)
  69. End Sub
  70. Function GetMainKeyHandle(MainKeyName As String) As Long
  71. Const HKEY_CLASSES_ROOT = &H80000000
  72. Const HKEY_CURRENT_USER = &H80000001
  73. Const HKEY_LOCAL_MACHINE = &H80000002
  74. Const HKEY_USERS = &H80000003
  75. Const HKEY_PERFORMANCE_DATA = &H80000004
  76. Const HKEY_CURRENT_CONFIG = &H80000005
  77. Const HKEY_DYN_DATA = &H80000006
  78. Select Case MainKeyName
  79.        Case "HKEY_CLASSES_ROOT"
  80.             GetMainKeyHandle = HKEY_CLASSES_ROOT
  81.        Case "HKEY_CURRENT_USER"
  82.             GetMainKeyHandle = HKEY_CURRENT_USER
  83.        Case "HKEY_LOCAL_MACHINE"
  84.             GetMainKeyHandle = HKEY_LOCAL_MACHINE
  85.        Case "HKEY_USERS"
  86.             GetMainKeyHandle = HKEY_USERS
  87.        Case "HKEY_PERFORMANCE_DATA"
  88.             GetMainKeyHandle = HKEY_PERFORMANCE_DATA
  89.        Case "HKEY_CURRENT_CONFIG"
  90.             GetMainKeyHandle = HKEY_CURRENT_CONFIG
  91.        Case "HKEY_DYN_DATA"
  92.             GetMainKeyHandle = HKEY_DYN_DATA
  93. End Select
  94. End Function
  95. Private Sub ParseKey(keyname As String, Keyhandle As Long)
  96. rtn = InStr(keyname, "\")
  97. If Left(keyname, 5) <> "HKEY_" Or Right(keyname, 1) = "\" Then
  98.    MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + keyname
  99.    Exit Sub
  100. ElseIf rtn = 0 Then
  101.    Keyhandle = GetMainKeyHandle(keyname)
  102.    keyname = ""
  103. Else
  104.    Keyhandle = GetMainKeyHandle(Left(keyname, rtn - 1))
  105.    keyname = Right(keyname, Len(keyname) - rtn)
  106. End If
  107. End Sub
  108. Function GetStringValue(subkey As String, entry As String)
  109. On Error Resume Next
  110. Call ParseKey(subkey, MainKeyHandle)
  111. If MainKeyHandle Then
  112.    rtn = RegOpenKeyEx(MainKeyHandle, subkey, 0, KEY_READ, hKey)
  113.    If rtn = ERROR_SUCCESS Then
  114.       sBuffer = Space(255)
  115.       lBufferSize = Len(sBuffer)
  116.       rtn = RegQueryValueEx(hKey, entry, 0, REG_SZ, sBuffer, lBufferSize)
  117.       If rtn = ERROR_SUCCESS Then
  118.          rtn = RegCloseKey(hKey)
  119.          sBuffer = Trim(sBuffer)
  120.          GetStringValue = Left(sBuffer, Len(sBuffer) - 1)
  121.       Else
  122.          GetStringValue = "Error"
  123.          If DisplayErrorMsg = True Then
  124.             MsgBox ErrorMsg(rtn)
  125.          End If
  126.       End If
  127.    Else
  128.       GetStringValue = "Error"
  129.       If DisplayErrorMsg = True Then
  130.          MsgBox ErrorMsg(rtn)
  131.       End If
  132.    End If
  133. End If
  134. End Function
  135. Function SetStringValue(subkey As String, entry As String, Value As String)
  136. Call ParseKey(subkey, MainKeyHandle)
  137. If MainKeyHandle Then
  138.    rtn = RegOpenKeyEx(MainKeyHandle, subkey, 0, KEY_WRITE, hKey)
  139.    If rtn = ERROR_SUCCESS Then
  140.       rtn = RegSetValueEx(hKey, entry, 0, REG_SZ, ByVal Value, Len(Value))
  141.       If Not rtn = ERROR_SUCCESS Then
  142.          If DisplayErrorMsg = True Then
  143.             MsgBox ErrorMsg(rtn)
  144.          End If
  145.       End If
  146.       rtn = RegCloseKey(hKey)
  147.    Else
  148.       If DisplayErrorMsg = True Then
  149.          MsgBox ErrorMsg(rtn)
  150.       End If
  151.    End If
  152. End If
  153. End Function
  154. Function ErrorMsg(lErrorCode As Long) As String
  155. Select Case lErrorCode
  156.        Case 1009, 1015
  157.             GetErrorMsg = "The Registry Database is corrupt!"
  158.        Case 2, 1010
  159.             GetErrorMsg = "Bad Key Name"
  160.        Case 1011
  161.             GetErrorMsg = "Can't Open Key"
  162.        Case 4, 1012
  163.             GetErrorMsg = "Can't Read Key"
  164.        Case 5
  165.             GetErrorMsg = "Access to this key is denied"
  166.        Case 1013
  167.             GetErrorMsg = "Can't Write Key"
  168.        Case 8, 14
  169.             GetErrorMsg = "Out of memory"
  170.        Case 87
  171.             GetErrorMsg = "Invalid Parameter"
  172.        Case 234
  173.             GetErrorMsg = "There is more data than the buffer has been allocated to hold."
  174.        Case Else
  175.             GetErrorMsg = "Undefined Error Code:  " & Str$(lErrorCode)
  176. End Select
  177. End Function
  178.